home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 5 / Skunkware 5.iso / src / Tools / ObjectTcl-1.1 / tkMain.C < prev   
Encoding:
C/C++ Source or Header  |  1995-06-30  |  11.4 KB  |  441 lines
  1. /* 
  2.  * Hacked version of Tk 3.3 main.  This is supplied so that otcl will work
  3.  * with either Tcl/Tk 7.3/3.6 or 7.4/4.0.  It checks for a 7.4 only define in
  4.  * tcl.h.  For 3.6, it geterates no code.  For Tcl 7.3, it generates a function
  5.  * Tk_Main like one would find in 4.0.
  6.  *
  7.  * main.c --
  8.  *
  9.  *    This file contains the main program for "wish", a windowing
  10.  *    shell based on Tk and Tcl.  It also provides a template that
  11.  *    can be used as the basis for main programs for other Tk
  12.  *    applications.
  13.  *
  14.  * Copyright (c) 1990-1993 The Regents of the University of California.
  15.  * All rights reserved.
  16.  *
  17.  * Permission is hereby granted, without written agreement and without
  18.  * license or royalty fees, to use, copy, modify, and distribute this
  19.  * software and its documentation for any purpose, provided that the
  20.  * above copyright notice and the following two paragraphs appear in
  21.  * all copies of this software.
  22.  * 
  23.  * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
  24.  * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
  25.  * OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
  26.  * CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  27.  *
  28.  * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
  29.  * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
  30.  * AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
  31.  * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
  32.  * PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
  33.  */
  34.  
  35. #ifndef lint
  36. static char rcsid[] = "$Header: /e/WESE/ObjectTcl/tkMain.C,v 1.2 1995/05/11 14:42:26 deans Exp $ SPRITE (Berkeley)";
  37. #endif
  38.  
  39. #include <stdio.h>
  40. #include <tcl.h>
  41. #if TCL_MINOR_VERSION == 3
  42. #include <stdlib.h>
  43. #include <string.h>
  44. #include <unistd.h>
  45. #include <tk.h>
  46. #include "Otcl.H"
  47.  
  48. /*
  49.  * Global variables used by the main program:
  50.  */
  51.  
  52. static Tk_Window mainWindow;    /* The main window for the application.  If
  53.                  * NULL then the application no longer
  54.                  * exists. */
  55. static Tcl_Interp *interp;    /* Interpreter for this application. */
  56. static Tcl_DString command;    /* Used to assemble lines of terminal input
  57.                  * into Tcl commands. */
  58. static int tty;            /* Non-zero means standard input is a
  59.                  * terminal-like device.  Zero means it's
  60.                  * a file. */
  61. static char errorExitCmd[] = "exit 1";
  62.  
  63. /*
  64.  * Command-line options:
  65.  */
  66.  
  67. static int synchronize = 0;
  68. static char *fileName = NULL;
  69. static char *name = NULL;
  70. static char *display = NULL;
  71. static char *geometry = NULL;
  72.  
  73. static Tk_ArgvInfo argTable[] = {
  74.     {"-file", TK_ARGV_STRING, (char *) NULL, (char *) &fileName,
  75.     "File from which to read commands"},
  76.     {"-geometry", TK_ARGV_STRING, (char *) NULL, (char *) &geometry,
  77.     "Initial geometry for window"},
  78.     {"-display", TK_ARGV_STRING, (char *) NULL, (char *) &display,
  79.     "Display to use"},
  80.     {"-name", TK_ARGV_STRING, (char *) NULL, (char *) &name,
  81.     "Name to use for application"},
  82.     {"-sync", TK_ARGV_CONSTANT, (char *) 1, (char *) &synchronize,
  83.     "Use synchronous mode for display server"},
  84.     {(char *) NULL, TK_ARGV_END, (char *) NULL, (char *) NULL,
  85.     (char *) NULL}
  86. };
  87.  
  88. /*
  89.  * Declaration for Tcl command procedure to create demo widget.  This
  90.  * procedure is only invoked if SQUARE_DEMO is defined.
  91.  */
  92.  
  93. extern int SquareCmd _ANSI_ARGS_((ClientData clientData,
  94.     Tcl_Interp *interp, int argc, char *argv[]));
  95.  
  96. /*
  97.  * Forward declarations for procedures defined later in this file:
  98.  */
  99.  
  100. static void        Prompt _ANSI_ARGS_((Tcl_Interp *interp, int partial));
  101. static void        StdinProc _ANSI_ARGS_((ClientData clientData,
  102.                 int mask));
  103.  
  104. /*
  105.  *----------------------------------------------------------------------
  106.  *
  107.  * main --
  108.  *
  109.  *    Main program for Wish.
  110.  *
  111.  * Results:
  112.  *    None. This procedure never returns (it exits the process when
  113.  *    it's done
  114.  *
  115.  * Side effects:
  116.  *    This procedure initializes the wish world and then starts
  117.  *    interpreting commands;  almost anything could happen, depending
  118.  *    on the script being interpreted.
  119.  *
  120.  *----------------------------------------------------------------------
  121.  */
  122.  
  123. extern "C" void
  124. Tk_Main(int argc,            /* Number of arguments. */
  125.         char **argv)            /* Array of argument strings. */
  126. {
  127.     char *args, *p, *msg;
  128.     char buf[20];
  129.     int code;
  130.  
  131.     interp = Tcl_CreateInterp();
  132. #ifdef TCL_MEM_DEBUG
  133.     Tcl_InitMemory(interp);
  134. #endif
  135.  
  136.     /*
  137.      * Parse command-line arguments.
  138.      */
  139.  
  140.     if (Tk_ParseArgv(interp, (Tk_Window) NULL, &argc, argv, argTable, 0)
  141.         != TCL_OK) {
  142.     fprintf(stderr, "%s\n", interp->result);
  143.     exit(1);
  144.     }
  145.     if (name == NULL) {
  146.     if (fileName != NULL) {
  147.         p = fileName;
  148.     } else {
  149.         p = argv[0];
  150.     }
  151.     name = strrchr(p, '/');
  152.     if (name != NULL) {
  153.         name++;
  154.     } else {
  155.         name = p;
  156.     }
  157.     }
  158.  
  159.     /*
  160.      * If a display was specified, put it into the DISPLAY
  161.      * environment variable so that it will be available for
  162.      * any sub-processes created by us.
  163.      */
  164.  
  165.     if (display != NULL) {
  166.     Tcl_SetVar2(interp, "env", "DISPLAY", display, TCL_GLOBAL_ONLY);
  167.     }
  168.  
  169.     /*
  170.      * Initialize the Tk application.
  171.      */
  172.  
  173.     mainWindow = Tk_CreateMainWindow(interp, display, name, "Tk");
  174.     if (mainWindow == NULL) {
  175.     fprintf(stderr, "%s\n", interp->result);
  176.     exit(1);
  177.     }
  178.     if (synchronize) {
  179.     XSynchronize(Tk_Display(mainWindow), True);
  180.     }
  181.     Tk_GeometryRequest(mainWindow, 200, 200);
  182.  
  183.     /*
  184.      * Make command-line arguments available in the Tcl variables "argc"
  185.      * and "argv".  Also set the "geometry" variable from the geometry
  186.      * specified on the command line.
  187.      */
  188.  
  189.     args = Tcl_Merge(argc-1, argv+1);
  190.     Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY);
  191.     ckfree(args);
  192.     sprintf(buf, "%d", argc-1);
  193.     Tcl_SetVar(interp, "argc", buf, TCL_GLOBAL_ONLY);
  194.     Tcl_SetVar(interp, "argv0", (fileName != NULL) ? fileName : argv[0],
  195.         TCL_GLOBAL_ONLY);
  196.     if (geometry != NULL) {
  197.     Tcl_SetVar(interp, "geometry", geometry, TCL_GLOBAL_ONLY);
  198.     }
  199.  
  200.     /*
  201.      * Set the "tcl_interactive" variable.
  202.      */
  203.  
  204.     tty = isatty(0);
  205.     Tcl_SetVar(interp, "tcl_interactive",
  206.         ((fileName == NULL) && tty) ? "1" : "0", TCL_GLOBAL_ONLY);
  207.  
  208.     /*
  209.      * Add a few application-specific commands to the application's
  210.      * interpreter.
  211.      */
  212.  
  213. #ifdef SQUARE_DEMO
  214.     Tcl_CreateCommand(interp, "square", SquareCmd, (ClientData) mainWindow,
  215.         (void (*)()) NULL);
  216. #endif
  217.  
  218.     /*
  219.      * Invoke application-specific initialization.
  220.      */
  221.  
  222.     if (Tcl_AppInit(interp) != TCL_OK) {
  223.     fprintf(stderr, "Tcl_AppInit failed: %s\n", interp->result);
  224.     }
  225.  
  226.     /*
  227.      * Set the geometry of the main window, if requested.
  228.      */
  229.  
  230.     if (geometry != NULL) {
  231.     code = Tcl_VarEval(interp, "wm geometry . ", geometry, (char *) NULL);
  232.     if (code != TCL_OK) {
  233.         fprintf(stderr, "%s\n", interp->result);
  234.     }
  235.     }
  236.  
  237.     /*
  238.      * Invoke the script specified on the command line, if any.
  239.      */
  240.  
  241.     if (fileName != NULL) {
  242.     code = Tcl_VarEval(interp, "source ", fileName, (char *) NULL);
  243.     if (code != TCL_OK) {
  244.         goto error;
  245.     }
  246.     tty = 0;
  247.     } else {
  248.     /*
  249.      * Commands will come from standard input, so set up an event
  250.      * handler for standard input.  If the input device is aEvaluate the
  251.      * .rc file, if one has been specified, set up an event handler
  252.      * for standard input, and print a prompt if the input
  253.      * device is a terminal.
  254.      */
  255.  
  256.     if (tcl_RcFileName != NULL) {
  257.         Tcl_DString buffer;
  258.         char *fullName;
  259.         FILE *f;
  260.     
  261.         fullName = Tcl_TildeSubst(interp, tcl_RcFileName, &buffer);
  262.         if (fullName == NULL) {
  263.         fprintf(stderr, "%s\n", interp->result);
  264.         } else {
  265.         f = fopen(fullName, "r");
  266.         if (f != NULL) {
  267.             code = Tcl_EvalFile(interp, fullName);
  268.             if (code != TCL_OK) {
  269.             fprintf(stderr, "%s\n", interp->result);
  270.             }
  271.             fclose(f);
  272.         }
  273.         }
  274.         Tcl_DStringFree(&buffer);
  275.     }
  276.     Tk_CreateFileHandler(0, TK_READABLE, StdinProc, (ClientData) 0);
  277.     if (tty) {
  278.         Prompt(interp, 0);
  279.     }
  280.     }
  281.     fflush(stdout);
  282.     Tcl_DStringInit(&command);
  283.  
  284.     /*
  285.      * Loop infinitely, waiting for commands to execute.  When there
  286.      * are no windows left, Tk_MainLoop returns and we exit.
  287.      */
  288.  
  289.     Tk_MainLoop();
  290.  
  291.     /*
  292.      * Don't exit directly, but rather invoke the Tcl "exit" command.
  293.      * This gives the application the opportunity to redefine "exit"
  294.      * to do additional cleanup.
  295.      */
  296.  
  297.     Tcl_Eval(interp, "exit");
  298.     exit(1);
  299.  
  300. error:
  301.     msg = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
  302.     if (msg == NULL) {
  303.     msg = interp->result;
  304.     }
  305.     fprintf(stderr, "%s\n", msg);
  306.     Tcl_Eval(interp, errorExitCmd);
  307. }
  308.  
  309. /*
  310.  *----------------------------------------------------------------------
  311.  *
  312.  * StdinProc --
  313.  *
  314.  *    This procedure is invoked by the event dispatcher whenever
  315.  *    standard input becomes readable.  It grabs the next line of
  316.  *    input characters, adds them to a command being assembled, and
  317.  *    executes the command if it's complete.
  318.  *
  319.  * Results:
  320.  *    None.
  321.  *
  322.  * Side effects:
  323.  *    Could be almost arbitrary, depending on the command that's
  324.  *    typed.
  325.  *
  326.  *----------------------------------------------------------------------
  327.  */
  328.  
  329.     /* ARGSUSED */
  330. static void
  331. StdinProc(ClientData clientData,        /* Not used. */
  332.           int mask)                /* Not used. */
  333. {
  334. #define BUFFER_SIZE 4000
  335.     char input[BUFFER_SIZE+1];
  336.     static int gotPartial = 0;
  337.     char *cmd;
  338.     int code, count;
  339.  
  340.     count = read(fileno(stdin), input, BUFFER_SIZE);
  341.     if (count <= 0) {
  342.     if (!gotPartial) {
  343.         if (tty) {
  344.         Tcl_Eval(interp, "exit");
  345.         exit(1);
  346.         } else {
  347.         Tk_DeleteFileHandler(0);
  348.         }
  349.         return;
  350.     } else {
  351.         count = 0;
  352.     }
  353.     }
  354.     cmd = Tcl_DStringAppend(&command, input, count);
  355.     if (count != 0) {
  356.     if ((input[count-1] != '\n') && (input[count-1] != ';')) {
  357.         gotPartial = 1;
  358.         goto prompt;
  359.     }
  360.     if (!Tcl_CommandComplete(cmd)) {
  361.         gotPartial = 1;
  362.         goto prompt;
  363.     }
  364.     }
  365.     gotPartial = 0;
  366.  
  367.     /*
  368.      * Disable the stdin file handler while evaluating the command;
  369.      * otherwise if the command re-enters the event loop we might
  370.      * process commands from stdin before the current command is
  371.      * finished.  Among other things, this will trash the text of the
  372.      * command being evaluated.
  373.      */
  374.  
  375.     Tk_CreateFileHandler(0, 0, StdinProc, (ClientData) 0);
  376.     code = Tcl_RecordAndEval(interp, cmd, 0);
  377.     Tk_CreateFileHandler(0, TK_READABLE, StdinProc, (ClientData) 0);
  378.     Tcl_DStringFree(&command);
  379.     if (*interp->result != 0) {
  380.     if ((code != TCL_OK) || (tty)) {
  381.         printf("%s\n", interp->result);
  382.     }
  383.     }
  384.  
  385.     /*
  386.      * Output a prompt.
  387.      */
  388.  
  389.     prompt:
  390.     if (tty) {
  391.     Prompt(interp, gotPartial);
  392.     }
  393. }
  394.  
  395. /*
  396.  *----------------------------------------------------------------------
  397.  *
  398.  * Prompt --
  399.  *
  400.  *    Issue a prompt on standard output, or invoke a script
  401.  *    to issue the prompt.
  402.  *
  403.  * Results:
  404.  *    None.
  405.  *
  406.  * Side effects:
  407.  *    A prompt gets output, and a Tcl script may be evaluated
  408.  *    in interp.
  409.  *
  410.  *----------------------------------------------------------------------
  411.  */
  412.  
  413. static void
  414. Prompt(Tcl_Interp *interp,        /* Interpreter to use for prompting. */
  415.        int partial)            /* Non-zero means there already
  416.                      * exists a partial command, so use
  417.                      * the secondary prompt. */
  418. {
  419.     char *promptCmd;
  420.     int code;
  421.  
  422.     promptCmd = Tcl_GetVar(interp,
  423.     partial ? "tcl_prompt2" : "tcl_prompt1", TCL_GLOBAL_ONLY);
  424.     if (promptCmd == NULL) {
  425.     defaultPrompt:
  426.     if (!partial) {
  427.         fputs("% ", stdout);
  428.     }
  429.     } else {
  430.     code = Tcl_Eval(interp, promptCmd);
  431.     if (code != TCL_OK) {
  432.         Tcl_AddErrorInfo(interp,
  433.             "\n    (script that generates prompt)");
  434.         fprintf(stderr, "%s\n", interp->result);
  435.         goto defaultPrompt;
  436.     }
  437.     }
  438.     fflush(stdout);
  439. }
  440. #endif
  441.